home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2006 May / PCWMAY06.iso / Software / Trial / ConceptDraw NetDiagrammer / data1.cab / Libraries__Project_Management / Project_Management / GanttChartTL.cdb < prev    next >
Text File  |  2006-02-08  |  5KB  |  144 lines
  1. ' ---------------------------------------------------------------------------
  2. Function SetTimeLineByReadyShape(shapeTask As Shape, shapeTL As Shape) As Integer
  3. On Error Resume Next
  4.     Dim shapeOldTL        As Shape
  5.     Dim shapeOldTLIs1D    As Boolean
  6.  
  7.     Set shapeOldTL = FindShapeByNameInGroup(shapeTask, "TimeLineS")
  8.     If shapeOldTL <> Null Then
  9.         shapeOldTLIs1D = shapeOldTL.Is1D
  10.         If shapeOldTL.ID <> shapeTL.ID Then
  11.             shapeTask.RemoveShapeByID(shapeOldTL.ID)
  12.         End If
  13.     End If
  14.     thisDoc.MoveShapeToGroup(shapeTL, shapeTask, 0, 0, -1)
  15.  
  16.     shapeTL.BeginY = shapeTask.Height*0.5
  17.     shapeTL.SetPropertyFormula("=Parent.Height*0.5", CDPT_BEGINY)
  18.     shapeTL.BeginX = shapeTask.ControlDot(1).X
  19.     shapeTL.SetPropertyFormula("=Parent.Controls.X1", CDPT_BEGINX)
  20.     shapeTL.EndX = shapeTask.ControlDot(2).X
  21.     shapeTL.SetPropertyFormula("=Parent.Controls.X2", CDPT_ENDX)
  22.     shapeTL.Variable(1).X = shapeTask.ControlDot(3).X - shapeTask.ControlDot(1).X
  23.     shapeTL.SetPropertyFormula("=Parent.Controls.X3-Parent.Controls.X1", CDPT_VARIABLE_X, 1)
  24.  
  25.     shapeTask.SetPropertyFormula("=2", CDPT_CONTROL_XBEHAVIOUR, 2)
  26.     shapeTask.SetPropertyFormula("=2", CDPT_CONTROL_XBEHAVIOUR, 3)
  27.     If NOT shapeOldTLIs1D Then
  28.         shapeTask.ControlDot(2).X = shapeTask.ControlDot(1).X + 100
  29.         shapeTask.ControlDot(3).X = shapeTask.ControlDot(1).X + 50
  30.         shapeTask.SetDefaultFormula(CDPT_CONTROL_X, 2)
  31.         shapeTask.SetDefaultFormula(CDPT_CONTROL_X, 3)
  32.     End If
  33.  
  34.     shapeTL.RecalcProperty(CDPT_BEGINY)
  35.     shapeTL.RecalcProperty(CDPT_BEGINX)
  36.     shapeTL.RecalcProperty(CDPT_ENDX)
  37.     shapeTL.RecalcProperty(CDPT_VARIABLE_X, 1)
  38.  
  39.     shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 2)
  40.     shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 3)
  41. End Function
  42. ' ---------------------------------------------------------------------------
  43. Function SetMilestoneByReadyShape(shapeTask As Shape, shapeTL As Shape) As Integer
  44. On Error Resume Next
  45.     Dim shapeOldTL    As Shape
  46.     Dim bToChange    As Boolean
  47.  
  48.     Set shapeOldTL = FindShapeByNameInGroup(shapeTask, "TimeLineS")
  49.     bToChange = True
  50.     If shapeOldTL <> Null Then
  51.         If shapeOldTL.Is1D Then
  52.             bToChange = (MsgBox("To change timeline?", cdbYesNo) = cdbYes)
  53.         End If
  54.     End If
  55.     If bToChange Then
  56.         If shapeOldTL <> Null Then
  57.             If shapeOldTL.ID <> shapeTL.ID Then
  58.                 shapeTask.RemoveShapeByID(shapeOldTL.ID)
  59.             End If
  60.         End If
  61.         thisDoc.MoveShapeToGroup(shapeTL, shapeTask, 0, 0, -1)
  62.         'shapeTL.GPinY = shapeTL.Height*0.5
  63.         'shapeTL.SetPropertyFormula("=Parent.Height*0.5", CDPT_GPINY)
  64.         'shapeTL.GPinX = shapeTL.ControlDot(1).X
  65.         'shapeTL.SetNullFormula(CDPT_GPINX)
  66.         'shapeTL.SetPropertyFormula("=Parent.Controls.X1", CDPT_GPINX)
  67.  
  68.         shapeTask.SetPropertyFormula("=7", CDPT_CONTROL_XBEHAVIOUR, 2)
  69.         shapeTask.SetPropertyFormula("=7", CDPT_CONTROL_XBEHAVIOUR, 3)
  70.         shapeTask.ControlDot(2).X = shapeTask.Width
  71.         shapeTask.ControlDot(3).X = shapeTask.Width
  72.         shapeTask.SetPropertyFormula("=Width", CDPT_CONTROL_X, 2)
  73.         shapeTask.SetPropertyFormula("=Width", CDPT_CONTROL_X, 3)
  74.  
  75.         shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 2)
  76.         shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 3)
  77.         shapeTask.RecalcProperty(CDPT_CONTROL_X, 2)
  78.         shapeTask.RecalcProperty(CDPT_CONTROL_X, 3)
  79.     Else
  80.         Dim NumControl As Long
  81.         Dim Ctrl1 As Long, Ctrl2 As Long
  82.         Ctrl1 = shapeTask.ControlDot(1).X + shapeTask.GPinX
  83.         Ctrl2 = shapeTask.ControlDot(2).X + shapeTask.GPinX
  84.         If Abs(Ctrl1 - shapeTL.GPinX) < Abs(Ctrl2 - shapeTL.GPinX) Then
  85.             NumControl = 1
  86.             shapeTL.GPinX = Ctrl1
  87.         Else
  88.             NumControl = 2
  89.             shapeTL.GPinX = Ctrl2
  90.         End If
  91.         shapeTL.SetPropertyFormula("=ObjID" & shapeTask.ID & ".Controls.X" & NumControl & "+ObjID" & shapeTask.ID & ".GPinX", CDPT_GPINX)
  92.         shapeTL.GPinY = shapeTask.GPinY + shapeTask.Height*0.5
  93.         shapeTL.SetPropertyFormula("=ObjID" & shapeTask.ID & ".GPinY+ObjID" & shapeTask.ID & ".Height*0.5", CDPT_GPINY)
  94.     End If
  95.  
  96.     shapeTL.RecalcProperty(CDPT_GPINY)
  97.     shapeTL.RecalcProperty(CDPT_GPINX)
  98. End Function
  99. ' ---------------------------------------------------------------------------
  100. Function TLPlaceMy(inTimeLine As Shape) As Boolean
  101. On Error Resume Next
  102.     Dim shapeTask As Shape
  103.     Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
  104.     Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
  105.  
  106.     If inTimeLine.Is1D Then
  107.         x1 = inTimeLine.BeginX
  108.         y1 = inTimeLine.BeginY
  109.         x2 = inTimeLine.EndX
  110.         y2 = inTimeLine.EndY
  111.     Else
  112.         x1 = inTimeLine.GPinX
  113.         y1 = inTimeLine.GPinY
  114.         x2 = x1
  115.         y2 = y1
  116.     End If
  117.     For I=thisDoc.ActivePage.ShapesNum() To 1 Step -1
  118.         If thisDoc.ActivePage.Shape(I).Name = "TaskBar" Then
  119.             Set shapeTask = thisDoc.ActivePage.Shape(I)
  120.             rx1 = shapeTask.GPinX
  121.             rx2 = shapeTask.GPinX + shapeTask.Width
  122.             ry1 = shapeTask.GPinY
  123.             ry2 = shapeTask.GPinY + shapeTask.Height
  124.             If LineInRect(x1, y1, x2, y2, rx1, ry1, rx2, ry2) = True Then
  125.                 If inTimeLine.Is1D Then
  126.                     SetTimeLineByReadyShape(shapeTask, inTimeLine)
  127.                 Else
  128.                     SetMilestoneByReadyShape(shapeTask, inTimeLine)
  129.                 End If
  130.                 Place = True
  131.                 Exit Function
  132.             End If
  133.         End If
  134.     Next
  135.     Place = False
  136. End Function
  137. ' ---------------------------------------------------------------------------
  138. If thisShape.Variable(1).Y = 0 Then
  139.     thisShape.Name = "TimeLineS"
  140.     TLPlaceMy(thisShape)
  141. End If
  142. thisShape.Variable(1).Y = 1
  143. ' ---------------------------------------------------------------------------
  144.